home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / INITOVLY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-09  |  7.2 KB  |  176 lines
  1. (*----------------------------------------------------------------------*)
  2. (*              InitOvly --- initialize PibTerm overlays                *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE InitOvly;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     PROCEDURE:  InitOvly                                             *)
  10. (*                                                                      *)
  11. (*     Purpose:    Initializes PibTerm directory for overlay searches   *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        InitOvly;                                                     *)
  16. (*                                                                      *)
  17. (*     Remarks:                                                         *)
  18. (*                                                                      *)
  19. (*        The PibTerm directory should have been set by a previous      *)
  20. (*        SET PIBTERM=   DOS specification.                             *)
  21. (*                                                                      *)
  22. (*----------------------------------------------------------------------*)
  23.  
  24. VAR
  25.    Ovr_Dir : AnyStr;
  26.    Ierr    : INTEGER;
  27.  
  28. (*----------------------------------------------------------------------*)
  29. (*      GetPibTermSpec --- get PibTerm directory from environment       *)
  30. (*----------------------------------------------------------------------*)
  31.  
  32. FUNCTION GetPibTermSpec: AnyStr;
  33.  
  34. (*----------------------------------------------------------------------*)
  35. (*                                                                      *)
  36. (*     Function:   GetPibTermSpec                                       *)
  37. (*                                                                      *)
  38. (*     Purpose:    Get PibTerm directory from DOS enviroment area       *)
  39. (*                                                                      *)
  40. (*     Calling Sequence:                                                *)
  41. (*                                                                      *)
  42. (*        PibTermDir := GetPibTermSpec : AnyStr;                        *)
  43. (*                                                                      *)
  44. (*           PibTermDir --- the PIBTERM= string from the DOS enviroment *)
  45. (*                          area, or the null string if not found.      *)
  46. (*                                                                      *)
  47. (*     Remarks:                                                         *)
  48. (*                                                                      *)
  49. (*        The PibTerm directory must have been set by a previous        *)
  50. (*        SET PIBTERM=   DOS specification.                             *)
  51. (*                                                                      *)
  52. (*----------------------------------------------------------------------*)
  53.  
  54. TYPE
  55.    DosEnv = ARRAY[0..32767] OF CHAR;
  56.  
  57. VAR
  58.    EnvPtr: ^DosEnv;
  59.    EnvStr: AnyStr;
  60.    Done  : BOOLEAN;
  61.    I     : INTEGER;
  62.  
  63. BEGIN (* GetPibTermSpec *)
  64.                                    (* Get address of DOS environment area *)
  65.  
  66.    EnvPtr := Ptr( MemW[ CSeg:$002C ] , 0 );
  67.  
  68.                                    (* Begin loop looking for 'PIBTERM='   *)
  69.    I              := 0;
  70.    Done           := FALSE;
  71.    EnvStr         := '';
  72.    GetPibTermSpec := '';
  73.  
  74.    REPEAT
  75.       IF EnvPtr^[I] = CHR( 0 ) THEN
  76.          BEGIN
  77.                                    (* Environment area ends with two      *)
  78.                                    (* successive 0 bytes.                 *)
  79.  
  80.             IF ( EnvPtr^[I+1] = CHR( 0 ) ) THEN
  81.                Done := TRUE;
  82.  
  83.                                    (* See if we have 'PIBTERM='. If so,   *)
  84.                                    (* extract the directory information.  *)
  85.  
  86.             IF ( COPY( EnvStr , 1 , 8 ) = 'PIBTERM=' ) THEN
  87.                BEGIN
  88.                   GetPibTermSpec := COPY( EnvStr, 9, LENGTH( EnvStr ) - 8 );
  89.                   Done           := TRUE;
  90.                END;
  91.  
  92.                                    (* Set current environment string to null *)
  93.             EnvStr := '';
  94.  
  95.          END
  96.       ELSE
  97.                                    (* Not CHR(0) --- append to current    *)
  98.                                    (* environment string being extracted. *)
  99.  
  100.          EnvStr := EnvStr + EnvPtr^[I];
  101.  
  102.       I := I + 1;
  103.  
  104.    UNTIL Done;
  105.  
  106. END    (* GetPibTermSpec *);
  107.  
  108. (*----------------------------------------------------------------------*)
  109.  
  110. BEGIN (* InitOvly *)
  111.                                    (* Search DOS environment for     *)
  112.                                    (* PIBTERM= definition.           *)
  113.    Ovr_Dir := GetPibTermSpec;
  114.                                    (* See if environment string      *)
  115.                                    (* makes sense.                   *)
  116.  
  117.    IF ( LENGTH( Ovr_Dir ) > 0 ) THEN
  118.       IF ( NOT ( Ovr_Dir[1] IN ['A'..'Z','a'..'z'] ) ) THEN
  119.          Ovr_Dir := '';
  120.  
  121.    IF ( LENGTH( Ovr_Dir ) > 0 ) THEN
  122.       BEGIN
  123.                                    (* PIBTERM= found in environment --- *)
  124.                                    (* set home drive and directory      *)
  125.  
  126.          IF ( Ovr_Dir[2] = ':' ) THEN
  127.             BEGIN
  128.                Home_Drive    := UpCase( Ovr_Dir[1] );
  129.                IF LENGTH( Ovr_Dir ) > 2 THEN
  130.                   Home_Dir_Path := COPY( Ovr_Dir, 3, LENGTH( Ovr_Dir ) - 2 )
  131.                ELSE
  132.                   Home_Dir_Path := '';
  133.             END
  134.          ELSE
  135.             BEGIN
  136.                Home_Drive    := Dir_Get_Default_Drive;
  137.                Home_Dir_Path := Ovr_Dir;
  138.             END;
  139.  
  140.          IF ( LENGTH( Home_Dir_Path ) > 0 ) THEN
  141.             IF ( Home_Dir_Path[ LENGTH( Home_Dir_Path ) ] = '\' ) THEN
  142.                IF LENGTH( Home_Dir_Path ) > 1 THEN
  143.                   Home_Dir_Path := COPY( Home_Dir_Path, 1,
  144.                                          LENGTH( Home_Dir_Path ) - 1 )
  145.                ELSE
  146.                   Home_Dir_Path := '';
  147.  
  148.          IF ( LENGTH( Home_Dir_Path ) > 0 ) THEN
  149.             IF ( Home_Dir_Path[ 1 ] = '\' ) THEN
  150.                IF LENGTH( Home_Dir_Path ) > 1 THEN
  151.                   Home_Dir_Path := COPY( Home_Dir_Path, 2,
  152.                                          LENGTH( Home_Dir_Path ) - 1 )
  153.                ELSE
  154.                   Home_Dir_Path := '';
  155.  
  156.       END
  157.    ELSE
  158.       BEGIN
  159.                                    (* No PIBTERM= in environment ---  *)
  160.                                    (* get current drive and directory *)
  161.  
  162.          Home_Drive := Dir_Get_Default_Drive;
  163.  
  164.          Ierr := Dir_Get_Current_Path( Home_Drive, Home_Dir_Path );
  165.  
  166.       END;
  167.                                    (* Make PibTerm files findable    *)
  168.  
  169.    IF ( Home_Dir_Path <> '')  THEN
  170.       Home_Dir := Home_Drive + ':\' + Home_Dir_Path + '\'
  171.    ELSE
  172.       Home_Dir := Home_Drive + ':';
  173.  
  174.    OvrPath( Home_Drive + ':\' + Home_Dir_Path );
  175.  
  176. END    (* InitOvly *);